Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/findfi1a/tree2.frm

Visual Basic Form | 1999-10-12 | 11.4 KB | 317 lines

VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form Form2
   Caption         =   "Exploring"
   ClientHeight    =   6555
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   7875
   LinkTopic       =   "Form2"
   ScaleHeight     =   6555
   ScaleWidth      =   7875
   StartUpPosition =   3  'Windows Default
   Begin VB.PictureBox splitter
      Height          =   6390
      Left            =   3225
      MousePointer    =   9  'Size W E
      ScaleHeight     =   6330
      ScaleWidth      =   270
      TabIndex        =   3
      Top             =   750
      Width           =   330
   End
   Begin VB.TextBox Txtpath
      Height          =   345
      Left            =   990
      TabIndex        =   2
      Top             =   0
      Width           =   9750
   End
   Begin ComctlLib.ListView ListView1
      Height          =   6420
      Left            =   3600
      TabIndex        =   1
      Top             =   720
      Width           =   8445
      _ExtentX        =   14896
      _ExtentY        =   11324
      View            =   3
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      _Version        =   327682
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   0
   End
   Begin ComctlLib.TreeView TreeView1
      Height          =   6435
      Left            =   30
      TabIndex        =   0
      Top             =   765
      Width           =   3135
      _ExtentX        =   5530
      _ExtentY        =   11351
      _Version        =   327682
      Indentation     =   529
      LineStyle       =   1
      Style           =   7
      ImageList       =   "ImageList1"
      Appearance      =   1
   End
   Begin VB.Label Label1
      Caption         =   "Address:"
      Height          =   315
      Left            =   60
      TabIndex        =   4
      Top             =   30
      Width           =   915
   End
   Begin ComctlLib.ImageList ImageList1
      Left            =   2790
      Top             =   2985
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   12632256
      _Version        =   327682
      BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7}
         NumListImages   =   2
         BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
            Picture         =   "tree2.frx":0000
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
            Picture         =   "tree2.frx":031A
            Key             =   ""
         EndProperty
      EndProperty
   End
Attribute VB_Name = "Form2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'variable to hold the width of the splitter bar
Private Const SPLT_WDTH As Integer = 3
Private ItemSelected As Integer
'variable to hold the last-sized position
Private currSplitPosX As Long
'variable to hold the horizontal & vertical
'offsets of the 2 controls
Dim CTRL_OFFSET As Integer
'variable to hold the Splitter bar colour
Dim SPLT_COLOUR As Long
Private Sub FilesSearch(drivepath As String, ext As String)
    Dim XDir() As String
    Dim tmpdir As String
    Dim FFound As String
    Dim DirCount As Integer
    Dim X As Integer
    Dim ls As ListItem
    Dim ns As Node
    Dim treechild As String
    Dim treekey As String
   'Initialises Variables
    DirCount = 0
    ReDim XDir(0) As String
    XDir(DirCount) = ""
    If Right(drivepath, 1) <> "\" Then
        drivepath = drivepath & "\"
    End If
    DoEvents
        tmpdir = Dir(drivepath, vbDirectory)
        Do While tmpdir <> ""
           If tmpdir <> "." And tmpdir <> ".." Then
               If (GetAttr(drivepath & tmpdir) And vbDirectory) = vbDirectory Then
                    treekey = drivepath & tmpdir
                    Set ns = TreeView1.Nodes.Add(, , treekey, tmpdir, 1, 2)
                    XDir(DirCount) = drivepath & tmpdir & "\"
                    DirCount = DirCount + 1
                    ReDim Preserve XDir(DirCount) As String
                End If
            End If
            tmpdir = Dir
         Loop

        'Searches for the files given by extension Ext
        FFound = Dir(drivepath & ext)
        Do Until FFound = ""
            Set ls = ListView1.ListItems.Add(1, "main" & FFound, FFound)
            ls.SubItems(1) = drivepath
            ls.SubItems(2) = Format(FileLen(drivepath & FFound), "###,###") & " Bytes"
            ls.SubItems(3) = FileDateTime(drivepath & FFound)
            FFound = Dir
        Loop

        'Recursive searches through all sub directories
        For X = 0 To (UBound(XDir) - 1)
             treechild = Left(XDir(X), Len(XDir(X)) - 1)
            FilesSearch1 XDir(X), ext, treechild
        Next X
End Sub
Private Sub Form_Load()
Dim path As String
    'set the startup variables
    CTRL_OFFSET = txtPath.Height
    SPLT_COLOUR = &H808080
    'set the current splitter bar position to an arbitrary value that
    '     will always be outside
    'the possible range. This allows us to check for movement of the
    '     spltter bar in subsequent
    'mousexxx subs.
    currSplitPosX = &H7FFFFFFF
    'ADD THE COLUMN HEADERS FOR THE LISTVIEW
    ListView1.ColumnHeaders.Add 1, "name", "Name"
    ListView1.ColumnHeaders.Add 2, "infolder", "In Folder"
    ListView1.ColumnHeaders.Add 3, "size", "Size"
    ListView1.ColumnHeaders.Add 4, "date", "Date Modified"
End Sub
Private Sub FilesSearch1(drivepath As String, ext As String, treekeys As String)
    Dim XDir() As String
    Dim tmpdir As String
    Dim FFound As String
    Dim DirCount As Integer
    Dim X As Integer
    Dim ls As ListItem
    Dim ns As Node
    Dim treechild As String
    Dim treekey As String
    'Initialises Variables
    DirCount = 0
    ReDim XDir(0) As String
    XDir(DirCount) = ""
    If Right(drivepath, 1) <> "\" Then
        drivepath = drivepath & "\"

    End If
    DoEvents
        tmpdir = Dir(drivepath, vbDirectory)
        Do While tmpdir <> ""
           If tmpdir <> "." And tmpdir <> ".." Then
               If (GetAttr(drivepath & tmpdir) And vbDirectory) = vbDirectory Then
                   treekey = drivepath & tmpdir
                   'SET THE KEY SAME AS THE PATH SO AS TO GET CORRECT VALUES INTO LISTVIEW WHEN THE TREEVIEW IS CLICKED
                   Set ns = TreeView1.Nodes.Add(treekeys, tvwChild, treekey, tmpdir, 1, 2)
                   XDir(DirCount) = drivepath & tmpdir & "\"
                    DirCount = DirCount + 1
                    ReDim Preserve XDir(DirCount) As String
                End If
            End If
            tmpdir = Dir
        Loop

        'Recursive searches through all sub directories
        For X = 0 To (UBound(XDir) - 1)
            treechild = Left(XDir(X), Len(XDir(X)) - 1)
            FilesSearch1 XDir(X), ext, treechild
        Next X
End Sub
Private Sub Form_Resize()
 Dim x1 As Integer, aErr$
    Dim x2 As Integer
    Dim height1 As Integer
    Dim width1 As Integer
    Dim width2 As Integer
    'set the height of the controls
    txtPath.Width = Me.Width + Label1.Width
    height1 = ScaleHeight + txtPath.Height - (CTRL_OFFSET * 2)
    width1 = TreeView1.Width
    x1 = 10 + 2
    x2 = x1 + width1 + SPLT_WDTH - 1 + 5
    width2 = ScaleWidth - x2 - 10
    'move the left list
    If Me.WindowState <> 1 Then
    TreeView1.Move x1 - 1, CTRL_OFFSET, width1, height1
    'move the right textbox
    ListView1.Move x2, CTRL_OFFSET, width2 + 1, height1
    'move the splitter bar
    splitter.Move x1 + TreeView1.Width - 1, CTRL_OFFSET, SPLT_WDTH, height1
    End If
End Sub
Private Sub txtPath_KeyDown(KeyCode As Integer, Shift As Integer)
'IF ENTER KEY IS PRESSED
If KeyCode = 13 Then
    FilesSearch txtPath, "*.*"
    Me.Caption = "Exploring" & txtPath
End If
End Sub
Private Sub TreeView1_DblClick()
Dim drivepath As String
Dim tmpdir$, ls As ListItem
ListView1.ListItems.Clear
drivepath = TreeView1.SelectedItem.Key & "\"
txtPath = TreeView1.SelectedItem.Key
Me.Caption = "Exploring" & txtPath
        tmpdir = Dir(drivepath, vbDirectory)
        Do While tmpdir <> ""

            If tmpdir <> "." And tmpdir <> ".." Then
               If (GetAttr(drivepath & tmpdir) And vbDirectory) <> vbDirectory Then
                    Set ls = ListView1.ListItems.Add(1, tmpdir, tmpdir)
                    ls.SubItems(1) = drivepath
                    ls.SubItems(2) = Format(FileLen(drivepath & tmpdir), "###,###") & " Bytes"
                    ls.SubItems(3) = FileDateTime(drivepath & tmpdir)
                End If
            End If
            tmpdir = Dir

        Loop
End Sub
Private Sub splitter_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbLeftButton Then
        'change the splitter colour
        splitter.BackColor = SPLT_COLOUR
        'set the current position to x
        currSplitPosX = CLng(X)
    Else
        'not the left button, so... if the current position <> defa
        '     ult, cause a mouseup
        If currSplitPosX <> &H7FFFFFFF Then splitter_MouseUp Button, Shift, X, Y
        'set the current position to the default value
        currSplitPosX = &H7FFFFFFF
    End If
End Sub
Private Sub splitter_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    'if the splitter has been moved...
   If currSplitPosX& <> &H7FFFFFFF Then

        'if the current position <> default, reposition the splitte
        '     r and set this as the current value
        If CLng(X) <> currSplitPosX Then
            splitter.Move splitter.Left + X, CTRL_OFFSET, SPLT_WDTH, ScaleHeight - (CTRL_OFFSET * 2)
            currSplitPosX = CLng(X)
        End If
    End If
  End Sub
Private Sub splitter_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    'if the splitter has been moved...
    If currSplitPosX <> &H7FFFFFFF Then
        'if the current position <> the last position do a final mo
        '     ve of the splitter
        If CLng(X) <> currSplitPosX Then
            splitter.Move splitter.Left + X, CTRL_OFFSET, SPLT_WDTH, ScaleHeight - (CTRL_OFFSET * 2)
        End If
        'call this the default position
        currSplitPosX = &H7FFFFFFF
        'restore the normal splitter colour
        splitter.BackColor = &H8000000F
        'and check for valid sizings. Either enforce the default minimum
        '     &
        'maximum widths for the left list, or, if within range, set the w
        '     idth.
        If splitter.Left > 60 And splitter.Left < (ScaleWidth - 60) Then
            TreeView1.Width = splitter.Left - TreeView1.Left 'the pane is within range
        ElseIf splitter.Left < 60 Then 'the pane is too small
            TreeView1.Width = 60
        Else: TreeView1.Width = ScaleWidth - 60 'the pane is too wide
        End If
       'reposition both lists, and the splitter bar
        Form_Resize
    End If
    End Sub